home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Language/OS - Multiplatform Resource Library
/
LANGUAGE OS.iso
/
forth
/
amiga
/
amigaker.arc
/
Forth.asm
< prev
next >
Wrap
Assembly Source File
|
1987-12-30
|
10KB
|
260 lines
;02May87pja Altered; can now supply a hex number after the startup
; command to specify the size of the user dictionary. Default
; is 64k. Can also supply a line which is interpreted at startup
; after the number, if supplied. This can supply a load command
; for instance. Any regular command can be executed.
; examples: 1> run Forth A000 load assem.txt
; 1> run Forth load editor.txt
; 1> run Forth 20000 cr .( hi ) cr
;04Apr87pja Changed, to use regular files.
* ForthII.asm 09Mar86pja
; -----------------------------------------------------------------------
; LABELS
; Labels starting with an underline are the CFA address of the Forth
; word.
; Other labels are internal to the assembly.
; Forth words to interface to the romcalls are identical to the rom
; manuals, but the stack picture is according to the MOVEM.L instruction
; ( why didn't Amiga do it that way, and supply a mask for each routine? )
; this is different to the C-language way of calling the routines.
; This assembler does not allow special character in the labels.
; Therefore names like + become _plus and ! becomes _store etc.
;**********************************************************************
SECTION ForthII
; register equates
;
rp equr A6
ip equr A5
w equr A4
; Note: A3 is reserved to hold the address of NEXT, this
; way a jump to next becomes: jmp (a3)
immediate equ 1<<6 ;flag to set the immediate bit of
;a word.
delayed equ 0 ;the opposite of immediate
rpstacksize equ 1024 ;stack size for return pointer
;NOTE: The standard stacksize is set by dos. I use 8k and have had no
; problems.
;************************************************************************
SECTION ForthII,BSS
keybuffer ds.b 32 ;buffer for console input
;raw keypresses are put here by calling SendIO, and
;are collected by forth word 'key'.
stdbuffer ds.b 256 ;buffer for output
;A scratch buffer used to output single characters (emit)
;or multiple characters (e.g. spaces,words)
tibbuffer ds.b 256 ;buffer for terminal input
;The forth input buffer, query, tib, source, are some
;of the words using the area.
rpstack ds.b rpstacksize ;return stack, long enough?
;************************************************************************
SECTION ForthII,CODE
;
;
;
link0 set 0 ;4 link pointer
link1 set 0
link2 set 0
link3 set 0
voc_link set 0 ;and a vocabulary link, used to traverse
;all the vocabulary names.
lib_link set 0 ;links all the Amiga libraries together.
file_link set 0 ;Files are linked to form a list.
;
;
start_t jmp cold ;COLD init routine
jmp warm ;WARM entry point
; next
next move.l (ip)+,w ;label - next
move.l (w)+,a0
jmp (a0)
; The following section does the calling of romroutines.
; It is self modifying code. ( sorry ).
; The registers loaded from the stack is modified.
; The index for the jump is also modified.
; The Forth state is saved. (a0/a3-a5) on the return stack and the return
; stack is saved on the stack. Other registers are not important.
; If any routine returns a value in D0 it is pushed onto the stack if
; the flag romcallflag is set.
romcall move.l a0,d0 ;test for 0 lib.base
beq warm ; reset the system then.
movem.l a0/a3-a5,-(rp) ;save forth state
movem.l (sp)+,d0-d1 ;this is modified to load regs
romcallx move.l a6,-(sp) ;save rp
move.l (rp),a6 ; library base
jsr 100(a6) ;the index is also changed
romcally move.l (sp)+,rp ;restore rp
movem.l (rp)+,a0/a3-a5 ;restore forth state
tst.w romcallflag ; if a value is returned
beq.s 1$ ; save it on the stack
move.l d0,-(sp)
1$ jmp (a3) ; jump to next
romcallflag dc.w 0 ;reset if no value to return
; To call a code word from within a code word and have it return to the
; caller, the following routine can be used. Call it as follows:
; lea _dup,w
; jsr callword
; No need to save any registers, unlike the callrom routine, see
; 05.romcalls, for that.
; This routine allows for nesting of these type of calls, using two cells
; for each nesting on the return stack. Take note that no routine is aborted
; by using "r> drop", that will not work properly. Watch for loops.
;
; It is not very efficient to use this extensively. Calls to code words
; at the end of the calling code word are better jumped to with a branch
; instruction. e.g. bra _dup+4.
;
; The advantage? The words execute faster. Each high level call in a
; colon definition has an overhead of 24 cycles. This is the 'next' routine
; For instance, dup can be done faster if coded as: move.l (sp),-(sp)
; The total time to execute from within a colon word is 24+20 and code is
; 20, a saving of 24 cycles. A greater saving is in branching and testing
; of stack components. The stack can be accessed in code like: tst.l 8(sp)
; that can save a 'rot dup >r -rot' sequence.
; Most code words can be bypassed using code in each word. The size
; savings are minimal!!! The callword routine should be used sparingly and
; only in cases where the called word is a sizable word. If used extensively
; the code word reverts to a hacked up next-like routine with a much larger
; overhead then next. Next is much more efficient.
; I know!! There are better methods, and in the future I'll use one.
;
callword move.l a3,-(rp) ;save current next address
move.l (sp)+,-(rp) ;save the callers address
lea callw_1,a3 ;will return there
move.l (w)+,a0 ;this will allow variable etc
jmp (a0) ; to work also.
callw_1 move.l (rp)+,a0 ;where to return to
move.l (rp)+,a3 ;restore current next address
jmp (a0)
;
;
* forth
dc.w -1
dc.l link2
link2 set *-4
dc.b $85,'fort',$80!'h'
cnop 0,2
_forth dc.l vocabulary_does ;points to >does of Vocabulary
dc.l Link0 ;four hash links for voc.
dc.l Link1
dc.l Link2
dc.l Link3
dc.l voc_link ;temporal linked list
voc_link set *-4
include "01.runtime"
include "02.stack"
include "03.math"
include "04.vars"
include "05.romcalls"
include "06.console"
include "07.dos"
include "08.files"
include "09.loading"
include "10.terminal"
include "11.number"
include "12.parsing"
include "13.dict"
include "14.compiler"
include "15.structs"
include "16.defining"
include "17.intuition"
include "18.init"
include "19.extend"
; define the newwindow structure at here, as soon as the window is opened
; it can be forgotten, or used as scratch area, except the windowname.
windowname dc.b 'Forth',0
cnop 0,2
here_window dc.w 0,0,640,200
dc.b -1,-1
dc.l 0,$1!$2!$4!$20!$1000!$20000 ;!$40
dc.l 0,0,windowname,0,0
dc.w 100,40,640,200,1
;
; resolve all the links created in the assembly.
;
Link0 equ link0
Link1 equ link1
Link2 equ link2
Link3 equ link3
execLink0 equ execlink0
execLink1 equ execlink1
execLink2 equ execlink2
execLink3 equ execlink3
dosLink0 equ doslink0
dosLink1 equ doslink1
dosLink2 equ doslink2
dosLink3 equ doslink3
intLink0 equ intlink0
intLink1 equ intlink1
intLink2 equ intlink2
intLink3 equ intlink3
rootLink0 equ rootlink0
rootLink1 equ rootlink1
rootLink2 equ rootlink2
rootLink3 equ rootlink3
Voc_link equ voc_link
Lib_link equ lib_link
File_link equ file_link
;
;
END